home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / doors_1 / fd200.zip / FD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-27  |  2.2 KB  |  94 lines
  1. {$R-}    {Range checking off}
  2. {$B+}    {Boolean complete evaluation on}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N-}    {No numeric coprocessor}
  6. {$V-}
  7. program Field_Day_Log_Duper;
  8. Uses
  9.   Crt,
  10.   Dos;
  11.  
  12. {$I FD_CONST.PAS }
  13. {$I FD_TYPE.PAS }
  14. {$I FD_VAR.PAS }
  15. {$I FD_COLOR.PAS }
  16. {$I FD_DOS.PAS }
  17.  
  18. procedure print(pdata : data); forward;
  19. procedure fprint(pdata : data); forward;
  20. function  cmp(d1, d2 : data): integer; forward;
  21. function  check_if_ok(d1 : data): integer; forward;
  22. procedure add_to_score(pdata : data); forward;
  23.  
  24. {$I AVL_TREE.PAS}
  25.  
  26. {$I FD_AVL.PAS}
  27. {$I FD_IMAGE.PAS }
  28. {$I FD_DISP.PAS }
  29. {$I FD_INIT.PAS }
  30. {$I FD_UTIL.PAS }
  31.  
  32. var fd_key : char;
  33.  
  34. BEGIN
  35.   root := NIL;
  36.   tbranch := talloc;
  37.   del_ptr := talloc;
  38.   read_init;
  39.   read_image;
  40.   set_x_y;
  41.   x := 0; y := 0;
  42.   save_entry_screen;
  43.   video_disable;
  44.   move(image1,video,4000);
  45.   video_enable;
  46.   disp_mode;
  47.   disp_band;
  48.   disp_score;
  49.   repeat
  50.     repeat date_time until keypressed;
  51.     fd_key := UpCase(readkey);
  52.     case fd_key of
  53.      'S' :begin
  54.             tbranch^.leaf.section := section;
  55.             disp_section(tbranch^.leaf.section);
  56.           end;
  57.      'D' : begin
  58.              if (find(root, tbranch) <> NIL)
  59.              then  found_it;
  60.            end;
  61.      'C' : tbranch^.leaf.callsign := enter_callsign;
  62.      'A' : tbranch^.leaf.class   := enter_class;
  63.      'B' : begin
  64.              change_band;
  65.              tbranch^.leaf.band := band;
  66.            end;
  67.      'M' : begin
  68.              change_mode;
  69.              tbranch^.leaf.xmtmode := op_mode;
  70.            end;
  71.      'U' : utility;
  72.      'E' : begin
  73.              if (length(tbranch^.leaf.callsign) > 0) AND
  74.                 (find(root, tbranch) = NIL)
  75.              then
  76.              begin
  77.                p := talloc;
  78.                if (p = NIL)
  79.                  then out_of_memory
  80.                  else begin
  81.                         p^.leaf := tbranch^.leaf;
  82.                         add_to_score(p^.leaf);
  83.                         insert(root,p);
  84.                         clear_all;
  85.                       end;
  86.              end
  87.              else found_it;
  88.            end;
  89.       #0 : fd_key := readkey;
  90.     end;
  91.     disp_score;
  92.   until FALSE;
  93. END.
  94.